perm filename EREAD.LSP[NEW,LSP] blob sn#357301 filedate 1978-07-10 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	 This function will perform the same function as
C00005 ENDMK
C⊗;
;;; This function will perform the same function as
;;; UREAD, but knows about E files. Note that it will
;;; work on either an E file or a non-E file.
(LAP SHOWIT SUBR) 
(ARGS SHOWIT (NIL . 0)) 
(MOVEI A 3)
(CALLI A 400011)
(MOVEI A 'T)
(POPJ P)
NIL 
(DECLARE (*EXPR SHOWIT) (*FEXPR UGREAT) (SPECIAL EFILEFLAG))
(defprop ugreat (direct fas dsk (mac lsp)) autoload)
(macrodef push (x) (setq pdl (cons x pdl)))
(macrodef pop () (setq file (cdr file)))
(macrodef check () (cond ((null file)(throw (nreverse pdl) out))))
(macrodef default (file)
(cond (file
 (catch (prog (pdl)
	 (push (car file))
	 (pop)
	 (push (cond ((or (null file)
			  (memq (car file) '(dsk sys))
		   	  (not (atom (car file)))) '/ )
		     (t (prog2 nil (car file) (pop)))))
	 (check)
	 (push (cond ((atom (car file)) (prog2 nil (car file)(pop)))
		     (t 'dsk)))
	 (check)
	 (push (cond ((= (length (car file)) 2)(car file))
		     (t (list (caar file)(cadr (status udir))))))
	 (throw (nreverse pdl) out))
  out))))

(DEFUN EREAD FEXPR (FILE) 
       ((LAMBDA (↑Q FILE) 
	 (COND ((EQ (CADR FILE) '/>)
		(RPLACA (CDR FILE) 
			     (APPLY 'UGREAT (CONS (CAR FILE)
						  (OR (CADDDR FILE)
						      (CADR (STATUS CRUNIT))))))))
	 (APPLY (FUNCTION UREAD) FILE)
			 (SETQ ↑Q T EFILEFLAG NIL)
			 ;;; All E files have C as the first character
			 (COND ((NOT (= (TYIPEEK) 67.)))
			 ;;; Look for COMMENT ⊗ VALID
			       ((AND (EQ (READ) 'COMMENT)
				     (EQ (READ) '⊗)
				     (EQ (READ) 'VALID))
				;;; Skip to end of directory
			  	(SETQ EFILEFLAG T)
				(DO I NIL NIL (= (TYI) 22.))
				(DO I NIL NIL (= (TYI) 12.)))
			       ;;; Looked like an E file for a while.
			       (T (APPLY (FUNCTION UREAD) FILE)))
			 )
	↑Q (DEFAULT FILE)
	)
	(SHOWIT)
       (STATUS CRUNIT))